home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 32 / Mac Magazin and MacEasy Magazine CD - Issue 32.iso / Multimedia / MIDI / MidiChaos_15 Folder / MidiChaos_1.5 / Source / Chaotic_critter next >
Text File  |  1995-04-28  |  4KB  |  198 lines
  1. \ This class will generate integer output from chaotic equations.
  2. \ 
  3. \ Author: Darren Gibbs  Copyright 1990
  4. \ Date: 4/24/90
  5. \
  6. \ MOD: RDG 5/22/90  Restructured for polyphony.
  7. \ MOD: RDG 10/1/90  Added new equations; Added FP ivars, made into object! 
  8.  
  9. ANEW TASK-CHAOTIC_CRITTER
  10.  
  11. 3.1415926536  FCONSTANT PI
  12.  
  13. 4 CONSTANT #FUNCTIONS
  14.   0 CONSTANT TRIG
  15.   1 CONSTANT KAC
  16.   2 CONSTANT LOGISTICS
  17.   3 CONSTANT INSECT
  18.  
  19. \ Define the functions.
  20. : TRIG.FUNC  ( -- )  ( p1 p2 x -- x' )
  21. \ x' = p1 sin(pi * x)
  22. \ 0 < x < 1 ; 0 < p1 < 1
  23.     FSWAP FDROP  \ don't need p2
  24.     PI F*  FSIN  F*
  25. ;    
  26.     
  27. : KAC.FUNC  ( -- )  ( p1 p2 x -- x' )   
  28. \ x' = p1 x      for x < .50
  29. \ x' = p1(1 - x) for x > .50
  30. \ 0 < x < 1 ; 1 < p1 < 2
  31.     FSWAP FDROP  \ don't need p2
  32.     FDUP .50 F<
  33.     IF F* 
  34.     ELSE 1.00  FSWAP  F-  F*   
  35.     THEN 
  36. ;
  37.  
  38. : LOGISTICS.FUNC  (  -- )  ( p1 p2 x -- x' )   
  39. \ x' = p1 x (1 - x)
  40. \ 0 < x < 1 ;  0 < p1 < 4
  41.     FSWAP FDROP    \ don't need p2
  42.     FDUP 1.00  FSWAP  F- F* F* 
  43. ;
  44.  
  45. : INSECT.FUNC  ( -- )  ( p1 p2 x -- x' )   
  46. \ x' = p1 x (1 + x)  EXP -p2
  47. \ 0 < x < 1 ; 1 < p2 < 10 ; 1 < p1 < 1000
  48.     FDUP 1.00  F+     
  49.     FROT         ( p1 x x+1 p2 -- )
  50.     FNEGATE  F**
  51.     F* F*
  52. ;
  53.  
  54. CREATE FUNCTION-LIST  
  55.     'c trig.func a, 'c kac.func a,  
  56.     'c logistics.func a,  'c insect.func a,
  57.                       
  58. : INDEX>CFA  ( index -- CFA , get CFA from index. )    
  59.     function-list  swap  cell* +  a@
  60. ;
  61.  
  62. TEXTROM FUNCTION-NAMES  ," Trig" ," Kac" ," Logistics" ," Insect" 
  63.  
  64. : GET.FUNCTION.NAME  ( index -- text )  ( -- )
  65.     function-names 
  66. ;
  67.  
  68. : GET.#FUNCTIONS  ( -- n )  ( -- )
  69.     #functions
  70. ;
  71.  
  72. : GET.FUNCTION.MIN/MAX  ( index -- p1min p1max p2min p2max )  ( -- )
  73.     CASE
  74.         TRIG         OF   1   99  0      ENDOF \ flags will disable fader
  75.         KAC         OF   1  199  0      ENDOF
  76.         LOGISTICS     OF 101  399  0      ENDOF
  77.         INSECT         OF 101 9999  0 999  ENDOF
  78.     ENDCASE
  79. ;
  80. : GET.FUNCTION.NOMINAL  ( index -- p1-nom p2-nom )  ( -- )
  81.     CASE
  82.         TRIG         OF  70 0  ENDOF
  83.         KAC         OF  80 1  ENDOF
  84.         LOGISTICS     OF 200 1  ENDOF
  85.         INSECT         OF 500 50 ENDOF
  86.     ENDCASE
  87. ;
  88.  
  89. \ -------------------------------------------------------------------------------
  90. \ Begin class definition
  91. \ -------------------------------------------------------------------------------
  92.  
  93. METHOD PUT.P1:           METHOD GET.P1:
  94. METHOD PUT.P2:          METHOD GET.P2:
  95. METHOD PUT.X:              METHOD GET.X:
  96. METHOD GET.FUNCTION:    METHOD USE.FUNCTION:
  97. METHOD EXEC.FP:
  98.  
  99. :CLASS OB.CHAOTIC_CRITTER <SUPER OBJECT
  100.  
  101.     IV.FLPT IV-P1
  102.     IV.FLPT IV-P2
  103.     IV.FLPT IV-X
  104.     IV.LONG    IV-CURRENT-FUNCTION
  105.  
  106.     OB.FP_LINEAR_SCALER IO-SCALING
  107.  
  108. :M PUT.P1:  ( r -- )  ( -- )
  109.     i>f 100.0 f/   iv=> iv-p1
  110. ;M
  111.  
  112. :M GET.P1:  ( -- p )  ( -- )
  113.     iv-p1 100.0 f* f>i   
  114. ;M
  115.  
  116. :M PUT.P2:  ( b -- )  ( -- )
  117.     i>f 100.0 f/   iv=> iv-p2
  118. ;M
  119.  
  120. :M GET.P2:  ( -- b )  ( -- )
  121.     iv-p2 100.0 f* f>i   
  122. ;M
  123.  
  124. :M PUT.X:  ( x -- )  ( -- )
  125.     i>f 100.0 f/   iv=> iv-x
  126. ;M
  127.  
  128. :M GET.X:  ( -- x )  ( -- )
  129.     iv-x 100.0 f* f>i   
  130. ;M
  131.  
  132. :M PUT.MIN:  ( min -- )  ( -- )
  133.     i>f  put.ylow: io-scaling
  134. ;M
  135.  
  136. :M PUT.MAX:  ( max -- )  ( -- )
  137.     i>f  put.yhi: io-scaling
  138. ;M
  139.  
  140. :M GET.MIN:  ( -- )  ( -- min )
  141.     get.ylow: io-scaling f>i
  142. ;M
  143.  
  144. :M GET.MAX:  ( -- )  ( -- max )
  145.     get.yhi: io-scaling f>i
  146. ;M
  147.  
  148. :M EXEC:  ( -- x )  ( -- )
  149.     iv-p1 iv-p2 iv-x
  150.     iv-current-function execute   
  151.     fdup iv=> iv-x
  152.     scale>int: io-scaling 
  153. ;M
  154.  
  155. :M EXEC.FP:  ( -- )  ( -- x )
  156.     iv-p1 iv-p2 iv-x
  157.     iv-current-function execute   
  158.     fdup iv=> iv-x
  159. ;M
  160.  
  161. :M USE.FUNCTION:  ( index -- )  ( -- )
  162.     dup  get.function.nominal  ( index p1-nom p2-nom -- )
  163.     put.p2: self   \ set params to reasonable values
  164.     put.p1: self 
  165.     50 put.x: self  
  166.     index>cfa  iv=> iv-current-function
  167. ;M
  168.  
  169. :M GET.FUNCTION:  ( -- index )  ( -- )
  170.     #functions 0  DO
  171.         I index>cfa  iv-current-function  =
  172.         IF I leave
  173.         THEN
  174.     LOOP
  175. ;M
  176.  
  177. :M PRINT:  ( -- )  ( -- )
  178.     cr name: self cr
  179.     ." Function: "   get.function: self  get.function.name  type cr
  180.     ."  P1: " get.p1: self  . cr
  181.     ."  P2: " get.p2: self  . cr
  182.     ."  X:  " get.x:  self  . cr
  183.     ."  Min Output: " get.min: self . cr
  184.     ."  Max Output: " get.max: self . cr
  185. ;M    
  186.     
  187. :M INIT:  ( -- )
  188.     init: super
  189.     trig index>cfa iv=> iv-current-function
  190.     70 put.p1: self
  191.     0 put.p2: self
  192.     80 put.x:  self
  193.     0.0 1.0 0.0 127.0  stuff:  io-scaling
  194. ;M 
  195.  
  196. ;CLASS
  197.  
  198.